perm filename MISEDG.SAI[SYS,HE]5 blob
sn#024409 filedate 1973-02-14 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00015 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 ENTRY IMAGE,REJSUB,XGETD,INSUB,CURVE
00008 00003 DEFINE DEBOUT(A)="IF TYP_EDGE THEN OUTSTR(A&CRLF)",
00012 00004 INITIALIZE PROGRAM FOR TV INPUT
00016 00005 SELECT CORRECT OBJECT BLOCK. VALUE IS POINTER OR -1
00018 00006 CALL MANFRED'S OPERATOR
00023 00007 INITIALIZE
00025 00008 ENTER MAXIMUM DEBUGGING MODE
00029 00009 ⊃ PROCEDURE TO DISPLAY COMPLEXITY OF SCENE AREAS
00031 00010 DELETE COMMAND - ARG SET TO OBJECT DELETED ON EXIT,
00034 00011 RELOOK COMMAND
00036 00012 FILL DATA ARRAY FROM EDGE DATA RINGS
00038 00013 DUMP DATA ARRAY ON DISK
00040 00014 GUTS OF GET_DATA COMMAND
00042 00015 FIT COMMAND STATUS=-1 ON ENTRY IF NO LINE EXTENDING
00050 ENDMK
⊗;
ENTRY IMAGE,REJSUB,XGETD,INSUB,CURVE;
BEGIN "MISC"
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
REQUIRE 500 STRING_SPACE;
EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY A);
EXTERNAL INTEGER PROCEDURE GLABEL(REFERENCE REAL FOO);
EXTERNAL BOOLEAN PROCEDURE EJLI(INTEGER X, Y, ANGLE, FLAG);
EXTERNAL PROCEDURE FORG.;
EXTERNAL INTEGER PROCEDURE GGETD(INTEGER PNTR, CNT; REFERENCE BOOLEAN E);
EXTERNAL BOOLEAN PROCEDURE GIFTIE(INTEGER PNTR, FLD; REFERENCE BOOLEAN E);
EXTERNAL PROCEDURE GDOWN(REFERENCE INTEGER PNTR, FLD; REFERENCE BOOLEAN E);
EXTERNAL PROCEDURE GFORWR(REFERENCE INTEGER PNTR, FLD; REFERENCE BOOLEAN E);
EXTERNAL PROCEDURE GBACK(REFERENCE INTEGER PNTR, FLD; REFERENCE BOOLEAN E);
EXTERNAL INTEGER PROCEDURE GKILBL(REFERENCE INTEGER P; REFERENCE BOOLEAN F);
EXTERNAL INTEGER PROCEDURE GETCOR(INTEGER SIZE);
EXTERNAL PROCEDURE RELCOR(INTEGER PNTR);
EXTERNAL BOOLEAN PROCEDURE GSTATZ(INTEGER MASK, PNTR; REFERENCE BOOLEAN ERR);
EXTERNAL BOOLEAN PROCEDURE GSETST(INTEGER MASK, PNTR; REFERENCE BOOLEAN ERR);
EXTERNAL BOOLEAN PROCEDURE GSTATO(INTEGER MASK,PNTR; REFERENCE BOOLEAN ERR);
EXTERNAL INTEGER PROCEDURE GCOUNT(INTEGER PNTR, FLD; REFERENCE BOOLEAN ERR);
EXTERNAL PROCEDURE PICINI(INTEGER C,F,E,P;REFERENCE BOOLEAN FAIL;
INTEGER ARRAY STOR);
EXTERNAL PROCEDURE PICRD(REFERENCE BOOLEAN FAIL; INTEGER ARRAY STOR);
EXTERNAL PROCEDURE PICWR(INTEGER CHAN,FILE,EXT,PPN;REFERENCE BOOLEAN FAIL;
INTEGER ARRAY STOR);
EXTERNAL PROCEDURE TRACCHK;
EXTERNAL BOOLEAN PROCEDURE EDGE_KKP(REFERENCE ITEMVAR A;REFERENCE INTEGER S);
EXTERNAL PROCEDURE GSTORD(INTEGER VAL,PNTR,CNT;REFERENCE BOOLEAN ERR);
FORTRAN PROCEDURE DATGET;
EXTERNAL INTEGER PROCEDURE SETANG(INTEGER X,Y);
EXTERNAL PROCEDURE OUTOBJ(REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE FADCHG(REAL X,Y;PROCEDURE FOO);
EXTERNAL INTEGER PROCEDURE GENTER(INTEGER X,Y; REFERENCE BOOLEAN TEST,DIR);
EXTERNAL PROCEDURE TVIN;
EXTERNAL PROCEDURE FINSCN(SET B; REFERENCE INTEGER S);
DEFINE DEBOUT(A)="IF TYP_EDGE THEN OUTSTR(A&CRLF)",
CRLF="'15&'12",
SAFEX="", GET(I)="FOOLX(GGETD(PNTR,I,FLAG))", STLEN="6", DSK="5",
⊃="COMMENT", D1MAX="1000", D2MAX="100", MANMAX="100",
OUTLIN="2",CORRNG="1",DISFRM="2",PNTNUM="1",OBJNUM="3",OBJPNT="1",
CORPNT="1", SEGPNT="1", OBJRNG="1", LIMIT="4", CAMERA="8";
SAFEX INTERNAL INTEGER ARRAY STACK, COSTKX, COSTKY[1:STLEN];
SAFEX REAL ARRAY ITEMVAR NEWCAM, OUTXY, INXY, RAI;
INTERNAL INTEGER DISPNT, BACKFL;
INTERNAL REAL OWID, ORX, ORY, OCL, OSL, OD, OB;
REAL OGRAD;
INTERNAL BOOLEAN DISFLG, ACCOMINIT;
BOOLEAN FLAG, MAXDEB, DO_COL;
INTEGER FLD, FRAM, I, N, PNTR, PPN, SIZE, TEMP, TEST, FRAMX, CHAN;
EXTERNAL INTEGER XSTRT, YSTRT, TVWORD, TMAX, BMAX, RSMAX, LSMAX, TOPLST,
OBJLST, PNTLST, GPNTR, TEMPNT, LSIDE, RSIDE, FLINE, LLINE, BCLIP,
TCLIP, SAITEM, DEFT, DEFB, DEFR, DEFLX, TVWID, SEGLST, CORLST,
CURTEM, DISTST, DEBFRM;
EXTERNAL REAL CIRCLE, SIDLEN;
EXTERNAL BOOLEAN STVFL, ST, STV, SLIM, EDGINIT, DEBDEL, DEBUGX;
SAFEX INTEGER ARRAY STORAG,STOR[1:25], DISPL2[1:D2MAX+5];
SAFEX INTERNAL INTEGER ARRAY DISPL1[1:D1MAX+5];
comment variables:
STACK,COSTKX,COSTKY are stacks containing the last STLEN coordinates seen
by the edge follower and the pointers to the data
structure entry.
DISPNT contains the current display frame number.
OBJCNT contains the object number.
DISFLG is TRUE if display has been suppressed for any reason.
ACCOMINIT is TRUE if accomodation routines are initialized.
CIRCLE is the radius of the Manfred operators
DO_COL is TRUE if filters to be changed during inside scaning;
SIMPLE INTERNAL PROCEDURE DPYPNT(INTEGER X,Y);
BEGIN EXTERNAL INTEGER DEBFRM;
INTEGER DSAVE;
DSAVE ← DPYPARS;
DPYSET(DISPL2);
APOINT(X*3-512,512-Y*3);
DPYOUT(DEBFRM);
DPYRESET(DSAVE);
END;
COMMENT INITIALIZE PROGRAM FOR TV INPUT
(TVWID IS LENGTH OF INPUT SQUARE);
SIMPLE INTERNAL PROCEDURE INITTV;
BEGIN
RELCOR(TVWORD);
SIZE ← (TVWID/9+2)*(TVWID+1);
IF SIZE<500 THEN SIZE ← 500;
STV ← STVFL ← ST ← FALSE;
TVWORD ← GETCOR(SIZE);
BACKFL ← 0;
DEFR ← 325;
DEFLX ← 10;
DEFT ← 15;
DEFB ← 250;
XSTRT ← YSTRT ← 0;
EDGINIT ← ACCOMINIT ← FALSE;
CHANGE_ACC ← TRUE;
IF CHAN≥0 THEN RELEASE(CHAN);
CHAN ← -1;
END;
PROCEDURE GETTRANS;
BEGIN INTEGER I;
I ← (STORAG[7]+2) DIV 3;
BEGIN REAL ARRAY FOO[1:I,1:3];
CURCAM ← GLOBAL NEW(FOO);
STOR[7] ← GLABEL(GLOBAL DATUM(CURCAM)[1,1]);
END;
END;
COMMENT INITIALIZE PROGRAM FOR DISK FILE NAM.DAT;
INTERNAL BOOLEAN PROCEDURE INITDK(STRING NAM);
BEGIN INTEGER I, FAIL;
LABEL L1;
RELCOR(TVWORD);
TVWORD ← 0;
STV ← STVFL ← ST ← TRUE;
N ← CVFIL(NAM,I,PPN);
IF CHAN≥0 THEN RELEASE(CHAN);
CHAN ← GETCHAN;
PICINI(CHAN,N,I,PPN,FAIL,STORAG);
IF FAIL∨¬STORAG[1] THEN
L1: BEGIN
INITTV;
RETURN(FALSE);
END;
TVWORD ← GETCOR(STORAG[1]);
BACKFL ← 0;
STOR[2] ← 0;
ARRBLT(STOR[3],STOR[2],23);
STOR[1] ← (TVWORD LAND '777777)+1;
IF STORAG[7] THEN GETTRANS ELSE CURCAM←CVI(0);
PICRD(FAIL,STOR);
IF FAIL THEN GO TO L1;
RSMAX ← DEFR ← RSIDE;
LSMAX ← DEFLX ← LSIDE;
TMAX ← DEFT ← FLINE;
BMAX ← DEFB ← LLINE;
BCLIP ← 7;
TCLIP ← 0;
XSTRT ← YSTRT ← 0;
ACCOMINIT ← TRUE;
EDGINIT ← CHANGE_ACC ← FALSE;
RETURN(TRUE);
END;
⊃ GET ANOTHER PICTURE FROM DISK FILE;
INTERNAL BOOLEAN PROCEDURE GETFIL(INTEGER IND);
BEGIN INTEGER FAIL,I;
LABEL L1, L2;
STRING STR;
IF STORAG[IND] THEN
L1: BEGIN
STOR[1] ← 0;
ARRBLT(STOR[2],STOR[1],24);
STOR[IND]←(TVWORD LAND '777777)+1;
PICRD(FAIL,STOR);
IF FAIL THEN OUTSTR("INPUT FAILED"&CRLF);
END ELSE OUTSTR("REQUESTED COLOR NOT IN THIS FILE"&CRLF);
L2: OUTSTR("FILE IS (NULL TO QUIT"&CRLF);
RELCOR(TVWORD);
TVWORD ← 0;
IF LENGTH(STV←INCHWL) THEN BEGIN INITTV; RETURN(FALSE); END;
N ← CVFIL(STR,I,PPN);
PICINI(CHAN,N,I,PPN,FAIL,STORAG);
IF FAIL∨¬STORAG[IND] THEN BEGIN OUTSTR("FAILED"&CRLF);GO TO L2;END;
TVWORD ← GETCOR(STORAG[IND]);
IF STORAG[7] THEN GETTRANS ELSE CURCAM←CVI(0);
RSMAX ← DEFR ← RSIDE;
LSMAX ← DEFLX ← LSIDE;
TMAX ← DEFT ← FLINE;
BMAX ← DEFB ← LLINE;
GO TO L1;
END;
COMMENT SELECT CORRECT OBJECT BLOCK. VALUE IS POINTER OR -1
IF NO BLOCK. EXECUTE XEQ IF FLG IS TRUE;
SIMPLE INTERNAL INTEGER PROCEDURE GETOBJ(REFERENCE ITEMVAR ARG;BOOLEAN FLG;
REFERENCE BOOLEAN PROCEDURE XEQ);
BEGIN ITEMVAR A;
LABEL L1;
IF ¬GIFTIE(PNTR←TOPLST,FLD←OBJPNT,FLAG)∨FLAG THEN RETURN(-1);
GDOWN(PNTR,FLD,FLAG);
TEST ← PNTR;
L1: IF ARG≠EVERY THEN
BEGIN
IF GGETD(PNTR,OBJNUM,FLAG)= CVN(ARG) THEN
RETURN(IF FLG∧¬XEQ(PNTR,ARG) THEN -1 ELSE PNTR)
END ELSE BEGIN
A ← CVI(GGETD(PNTR,OBJNUM,FLAG));
IF ¬FLG∨XEQ(PNTR,A) THEN BEGIN ARG←A;RETURN(PNTR);END;
END;
GFORWR(PNTR,FLD,FLAG);
IF PNTR≠TEST THEN GO TO L1;
RETURN(-1);
END;
COMMENT DUMMY ROUTINE FOR GETOBJ;
SIMPLE BOOLEAN PROCEDURE DUMMY(INTEGER A; ITEMVAR B);
RETURN(FALSE);
COMMENT CALL MANFRED'S OPERATOR
RETURNS:
-1 OUTSIDE FIELD OF VIEW
0 NOTHING SEEN
1 NOISY EDGE - JUMP AHEAD
2 FUNNY BRIGHNESS
3 OK;
INTERNAL INTEGER PROCEDURE YOPER(INTEGER X, Y; REFERENCE INTEGER ANGLE;
INTEGER CW; BOOLEAN TRAC,FLAG);
BEGIN
EXTERNAL REAL B, TM ,TP, OPX, OPY, CX, CY, LINWID;
EXTERNAL BOOLEAN WEAK, NOISY, NEARED, OPOOB, BCOMP, ISLINE, ISEDGE;
BOOLEAN VAL;
DEFINE OBOOL(X)="("" X= "")&(IF X THEN ""TRUE"" ELSE ""FALSE"")";
INTEGER I, RET, XX, YY;
PROCEDURE DISP(STRING LAB; INTEGER X, Y);
BEGIN EXTERNAL REAL COH, OPXM, OPYM, OPXP, OPYP;
SAFEX INTEGER ARRAY D[1:200];
STRING FOO;
INTEGER DPY, I, J;
GETFORMAT(I, J);
SETFORMAT(7,3);
IF DEBDEL THEN
BEGIN
DPY ← DPYPARS;
IF ¬MAXDEB THEN FRAMX ← GETPOG;
DPYSET(D);
DPYBRT(7);
FADCHG(0,0,AIVECT);
END;
FOO ← CRLF&" "&LAB&OBOOL(VAL)&CRLF&
"X,Y="&CVS(X)&","&CVS(Y)&" "&CVOS(X)&CVOS(Y)&CRLF&
"X,Y (P M)="&CVF(OPXP)&","&CVF(OPYP)&" "&CVF(OPX)&
","&CVF(OPY)&" "&CVF(OPXM)&","&CVF(OPYM)&CRLF&
"DIR. VECTOR="&CVF(CX)&","&CVF(CY)&CRLF&
"B, TM, TP="&CVF(B)&" "&CVF(TM)&" "&CVF(TP)&CRLF&
"COH, LINWID="&CVF(COH)&" "&CVF(LINWID)&CRLF&
OBOOL(WEAK)&OBOOL(NOISY)&OBOOL(NEARED)&OBOOL(BCOMP)&
CRLF&OBOOL(OPOOB)&OBOOL(ISLINE)&OBOOL(ISEDGE)&CRLF;
IF ¬MAXDEB THEN OUT(14,FOO);
IF DEBDEL THEN
BEGIN
DPYSST(FOO);
IF MAXDEB THEN
BEGIN
DPYBIG(4);
AIVECT(-300,-500);
DPYSST("DMODE: Accom, Exit, Video, Trace");
DPYSST(", Dump");
END;
DPYOUT(FRAMX);
IF ¬MAXDEB THEN
BEGIN
OUT(14,INCHWL&CRLF);
RELPOG(FRAMX);
END;
DPYRESET(DPY);
END;
SETFORMAT(I,J);
RETURN;
END;
OGRAD ← OWID ← -1.0;
VAL ← EJLI(X,Y,ANGLE,FLAG);
IF DEBUGX THEN DISP("FIRST", X, Y);
IF OPOOB THEN RETURN(-1);
IF VAL∧(NEARED∨BCOMP)∧((XX←ORX)≠X∨(YY←ORY))≠Y THEN
BEGIN
VAL ← EJLI(OPX+.5,OPY+.5,ANGLE,FLAG);
IF DEBUGX THEN DISP("SECOND", OPX+.5, OPY+.5);
IF OPOOB THEN RETURN(-1);
END;
OB ← B;
OD ← TM MAX (TM+TP);
IF VAL THEN
BEGIN
ORX ← OPX;
ORY ← OPY;
IF ¬BCOMP THEN BEGIN OCL ← CX;OSL ← CY;END;
ANGLE ← SETANG(OCL*15.0,OSL*15.0);
RET ← 3;
END ELSE IF NOISY THEN RET←1 ELSE RET←0;
IF DEBUGX THEN DPYPNT(X,Y);
IF OB=0∧OD=0 THEN
BEGIN
IF RET=3 THEN RET←2;
OB ← OD ←GENTER(X,Y,I←0,I);
END ELSE
IF RET≥0 THEN IF CW>0 THEN OD←OB+OD ELSE BEGIN OB↔OD;OB←OB+OD;END;
RETURN(RET);
END;
COMMENT INITIALIZE;
EXTERNAL PROCEDURE REGEN(INTEGER OBJLST);
SIMPLE INTERNAL PROCEDURE DISINT;
BEGIN INTEGER I;
IF ¬RUN THEN DPYTYP(-140,15,1);
DISTST ← 15;
DISFLG ← FALSE;
DPYSET(DISPL1);
DPYBRT(7);
DPYBIG(4);
GPNTR ← GIOWD(STACK);
OVERLAY ← TRUE;
IF DISDEV THEN RETURN;
I ← -1;
START_CODE DEFINE TTY="'51000000000";
TTY 6,I;
END;
DISDEV←IF I<0 THEN 2 ELSE IF I LAND '20000000 THEN 3 ELSE 1;
END;
COMMENT FOOL INTEGER → REAL TYPE CONVERSION CHECK;
SIMPLE INTERNAL REAL PROCEDURE FOOLX(INTEGER A);
BEGIN REAL C;
START_CODE DEFINE MOVE="'200000000000";
MOVE A;
MOVEM C;
END;
RETURN(C);
END;
SIMPLE INTERNAL PROCEDURE DISREL(INTEGER PNTR);
BEGIN
DISPNT ← GGETD(PNTR,DISFRM, FLAG);
IF DISPNT<0 THEN RETURN;
RELPOG(DISPNT);
GSTORD(-1,PNTR,DISFRM,FLAG);
REGEN(-1);
END;
SIMPLE INTERNAL PROCEDURE COLON;
DO_COL ← TRUE;
SIMPLE INTERNAL PROCEDURE COLOFF;
DO_COL ← FALSE;
COMMENT ENTER MAXIMUM DEBUGGING MODE;
INTERNAL PROCEDURE DMODE;
BEGIN REAL RAD;
LABEL OUTLAB;
INTEGER I, J, ANG, PNTR, TSAV, BSAV, LSAV, RSAV, PSAV;
EXTERNAL REAL ORX, ORY,TOLTRA;
EXTERNAL PROCEDURE INP;
EXTERNAL PROCEDURE EDGEON;
EXTERNAL INTEGER PROCEDURE SEEN(REAL X,Y,I;REFERENCE INTEGER P);
EXTERNAL PROCEDURE TRACE(INTEGER X,Y; REFERENCE ITEMVAR ARG;
REFERENCE INTEGER STAT);
EXTERNAL PROCEDURE VIDEO(INTEGER EXP, X, Y);
EXTERNAL BOOLEAN PROCEDURE ACCOMO(INTEGER X,Y;REFERENCE INTEGER A,C);
IF DISDEV≠2 THEN
BEGIN
OUTSTR("NO DEBUGGING ON THIS DEVICE"&CRLF);
RETURN;
END;
PSAV ← DPYPARS;
MAXDEB ← TRUE;
INP;
TSAV ← FLINE;
BSAV ← LLINE;
LSAV ← LSIDE;
RSAV ← RSIDE;
ANG ← 0;
FRAMX ← GETPOG;
IF DEBUGX∧DEBFRM≥0 THEN RELPOG(DEBFRM);
IF (DEBFRM←GETPOG)≥0 THEN DEBUGX ← TRUE ELSE
OUTSTR("NO FREE FRAMES"&CRLF);
RAD ← CIRCLE;
DEBDEL ← TRUE;
FOR I←BSAV STEP -RAD UNTIL TSAV DO FOR J←LSAV STEP RAD UNTIL RSAV DO
BEGIN INTEGER ANS, STAT;
ITEMVAR FOO;
LABEL L;
OUTSTR("YOPER="&CVS(STAT ← YOPER(J,I,ANG,0,FALSE,0))&CRLF);
IF STAT>0 THEN OUTSTR("SEEN="&CVOS(SEEN(ORX,ORY,TOLTRA,PNTR))
&" PNTR="&CVOS(PNTR)&CRLF);
L: ANS ← INCHWL;
IF ANS="Y" THEN GO TO OUTLAB;
IF ANS="T" THEN
BEGIN
DEBUGX ← DEBDEL ← MAXDEB ← FALSE;
RELPOG(FRAMX);
DPYRESET(PSAV);
TRACE(ORX+.5,ORY+.5,FOO,STAT);
PSAV ← DPYPARS;
OUTOBJ(STAT);
DEBUGX ← DEBDEL ← MAXDEB ← TRUE;
FRAMX ← GETPOG;
END;
IF ANS="V" THEN
BEGIN
FLINE ← TSAV;
LLINE ← BSAV;
LSIDE ← LSAV;
RSIDE ← RSAV;
TVIN;
VIDEO(2,LSIDE,FLINE);
GO TO L;
END;
IF ANS="A" THEN
BEGIN
OUTSTR("ACCOM="&CVS(ACCOMO(ORX+.5,ORY+.5,ANG,STAT←0))
&CRLF);
GO TO L;
END;
IF ANS="D" THEN
BEGIN "DSKOUT"
STRING NAM;
INTEGER I, N, FAIL;
INTEGER ARRAY STOR[1:25];
OUTSTR("FILE="&CRLF);
NAM ← INCHWL;
N ← CVFIL(NAM,I,PPN);
I ← GETCHAN;
STOR[2] ← 0;
ARRBLT(STOR[3],STOR[2],23);
STOR[1] ← TVWORD+1;
PICWR(I,N,CVSIX("DAT"),0,FAIL,STOR);
RELEASE(I);
END "DSKOUT";
END;
OUTLAB: DEBUGX ← DEBDEL ← MAXDEB←FALSE;
DPYRESET(PSAV);
RELPOG(FRAMX);
RELPOG(DEBFRM);
RETURN;
END;
⊃ PROCEDURE TO DISPLAY COMPLEXITY OF SCENE AREAS;
INTERNAL PROCEDURE PTSHOW;
BEGIN SAFEX INTEGER ARRAY BUF[1:1000];
EXTERNAL INTEGER PTSEEN, PTLENG;
EXTERNAL INTEGER PROCEDURE GLABEL(REFERENCE INTEGER A);
INTEGER FRAM, PT,J, K, L, M, PSAV;
DEFINE SQ="32",XS="((333/SQ)+1)",YS="(256/SQ)",SQH="SQ/2";
PSAV ← DPYPARS;
FRAM ← GETPOG;
DPYSET(BUF); DPYBIG(2); DPYBRT(7);
PT ← GLABEL(PTSEEN);
FOR I← XS-1 STEP -1 UNTIL 1 DO
BEGIN FADCHG(I*SQ,0,AIVECT);FADCHG(I*SQ,256,AVECT);END;
FOR I← YS-1 STEP -1 UNTIL 1 DO
BEGIN FADCHG(0,I*SQ,AIVECT);FADCHG(333,I*SQ,AVECT);END;
SETFORMAT(0,0);
FOR I←0 STEP 1 UNTIL PTLENG-1 DO
BEGIN "A"
START_CODE
MOVE 1,@PT;
MOVEM 1,SAITEM;
END;
PT ← PT+1;
IF SAITEM>0 THEN
BEGIN "C"
FADCHG((I MOD XS)*SQ+3,(I DIV XS)*SQ+SQH+5,AIVECT);
M ← GCOUNT(SAITEM,1,FLAG);
IF M>0 THEN
BEGIN "B"
K ← 0;
GDOWN(SAITEM,L←1,FLAG);
FOR J←1 STEP 1 UNTIL M DO
BEGIN
K←K+GCOUNT(SAITEM,1,FLAG);
GFORWR(SAITEM,L,FLAG);
END;
DPYSST(CVS(K));
END "B";
END "C";
END "A";
DPYOUT(FRAM);
INCHWL;
RELPOG(FRAM);
DPYRESET(PSAV);
REGEN(-1);
END;
COMMENT DELETE COMMAND - ARG SET TO OBJECT DELETED ON EXIT,
NIL IF NONE - STATUS=-1 IF NO OBJECT;
⊃ DELETE GLOBAL STRUCTURE FOR BLOB A;
INTERNAL PROCEDURE GLBDEL(ITEMVAR A);
BEGIN SET D;
DEFINE !="GLOBAL";
ITEMVAR I;
D ← (! POINT⊗A)∪(! LINE⊗A)∪(! BACKGROUND⊗A)∪(! REGION⊗A)
∪(! DANGLE⊗A);
FOREACH I | ! LINE⊗A≡I DO ! ERASE ENDPT⊗I≡ANY;
FOREACH I | ! REGION⊗A≡I DO
BEGIN
D ← D∪(! PERIMETER⊗I);
! ERASE PERIMETER⊗I≡ANY;
END;
FOREACH I | Iε{POINT,LINE,BACKGROUND,REGION,DANGLE} DO
! ERASE I⊗A≡ANY;
WHILE LENGTH(D) DO ! DELETE(LOP(D));
END;
INTERNAL PROCEDURE REJSUB(REFERENCE ITEMVAR ARG; REFERENCE INTEGER STATUS);
BEGIN EXTERNAL SET FNDBLB;
SAFEX REAL ARRAY ITEMVAR RAI;
STATUS ← 0;
IF (PNTR←GETOBJ(ARG,FALSE,DUMMY))<0 THEN
BEGIN
STATUS ← -1;
ARG ← NIL;
RETURN;
END;
DISREL(PNTR);
OBJLST ← PNTR;
FORG.;
TEMP ← PNTR;
GBACK(PNTR,FLD←OBJRNG,FLAG);
OBJLST ← PNTR;
REMOVE ARG FROM FNDBLB;
REMOVE ARG FROM BLOBS;
GLBDEL(ARG);
RAI ← CVI(GGETD(TEMP,CAMERA,FLAG));
GLOBAL ERASE XFORM⊗ARG≡ANY;
IF RAI≠NIL∧TYPEIT(RAI) THEN GLOBAL DELETE (RAI);
GKILBL(TEMP,FLAG);
SEGLST ← TEMPNT ← PNTLST ← -1;
FOR I←1 STEP 1 UNTIL STLEN DO STACK[I]←COSTKX[I]←COSTKY[I]←-1;
END;
COMMENT RELOOK COMMAND;
SIMPLE INTERNAL PROCEDURE LOOK(REFERENCE ITEMVAR ARG;
REFERENCE INTEGER STATUS; INTEGER X, Y);
BEGIN ITEMVAR Z;
INTEGER TOP, BOT, LEFT, RIGHT, HOR, VER;
REAL T,B,L,R;
BOOLEAN SAVE;
LABEL L2;
STATUS ← 0;
IF ARG=EVERY∨(PNTR←GETOBJ(ARG,FALSE,DUMMY))<0 THEN
BEGIN STATUS ← -1;ARG ← NIL;RETURN;END;
OBJLST ← PNTR;
IF ¬(ARGεBLOBS) THEN GO TO L2;
REMOVE ARG FROM BLOBS;
L2: PUT ARG IN OLDBLOB;
DATGET(OBJLST,LIMIT,4,T,B,L,R);
TOP ← T; BOT ← B; LEFT ← L; RIGHT ← R;
HOR ← (RIGHT-LEFT) DIV 2+15;
VER ← (BOT-TOP) DIV 2+15;
IF ¬X THEN X ← (RIGHT-LEFT) DIV 2+LEFT;
IF ¬Y THEN Y ← (BOT-TOP) DIV 2+TOP;
TOP ← Y-VER;
BOT ← Y+VER;
LEFT ← X-HOR;
RIGHT ← X+HOR;
IF TOP<TMAX THEN TOP ← TMAX;
IF BOT>BMAX THEN BOT←BMAX;
IF LEFT<LSMAX THEN LEFT ← LSMAX;
IF RIGHT>RSMAX THEN RIGHT ← RSMAX;
TOP ↔ TMAX;
BOT ↔ BMAX;
LEFT ↔ LSMAX;
RIGHT ↔ RSMAX;
XSTRT ← X;
YSTRT ← BMAX-(BMAX-TMAX) DIV 4;
REJSUB(Z←ARG, STATUS);
SAVE ← SLIM;
SLIM ← TRUE;
EDGE_KKP(ARG,STATUS);
SLIM ← SAVE;
ARG ← NIL;
STATUS ← 0;
TOP ↔ TMAX;
BOT ↔ BMAX;
LEFT ↔ LSMAX;
RIGHT ↔ RSMAX;
END;
COMMENT FILL DATA ARRAY FROM EDGE DATA RINGS;
SIMPLE PROCEDURE GET_DATA(SAFEX REAL ARRAY D;REFERENCE INTEGER CNT;LIST OBJS);
BEGIN REAL X,Y,SL,CL;
ITEMVAR AR;
INTEGER PA,FA,TA,PB,FB,TB,CURCNT,LASTPNT,PTR;
BOOLEAN CLOSED;
CNT ← 0;
WHILE LENGTH(OBJS) DO
BEGIN "OBJS"
AR←LOP(OBJS);
PTR ← GETOBJ(AR,FALSE,DUMMY);
IF PTR≤0 THEN CONTINUE;
D[CNT+1,3]←CVN(AR);
GDOWN(PA ← PTR, FA ← OUTLIN, FLAG);
TA ← PA LAND '777777;
DO BEGIN
CURCNT ← 0;
LASTPNT ← CNT ← CNT+1;
CLOSED ← GSTATZ(7,PA,FLAG);
GDOWN(PB ← PA, FB ← SEGPNT, FLAG);
IF ¬CLOSED THEN WHILE GSTATZ(24,PB,FLAG) DO
GBACK(PB,FB,FLAG);
IF GSTATO(8,PB,FLAG)∧GSTATZ(16,PB,FLAG) THEN
BEGIN
DEBOUT("""FLAG MISSING - GET_DATA""");
GFORWR(PB,FB,FLAG);
GSETST(16,PB,FLAG);
END;
TB ← PB LAND '777777;
DO BEGIN
CURCNT ← CURCNT+1;
DATGET(PB,1,4,X,Y,CL,SL);
D[CNT←CNT+1,1] ← X;
D[CNT,2] ← Y;
D[CNT,3] ← CL;
D[CNT,4] ← SL;
GFORWR(PB, FB, FLAG);
END UNTIL TB=(PB LAND '777777);
D[LASTPNT,1] ← CURCNT;
D[LASTPNT,2] ← CNT+1;
D[LASTPNT,4] ← CLOSED;
D[CNT+1,3] ← 0;
GFORWR(PA,FA,FLAG);
END UNTIL TA=(PA LAND '777777);
END "OBJS";
D[LASTPNT,2] ← 0;
END;
COMMENT DUMP DATA ARRAY ON DISK;
SIMPLE PROCEDURE DUMPDAT(SAFEX REAL ARRAY DAT; INTEGER K,KK);
BEGIN INTEGER LL,J,I;
OPEN(DSK,"DSK",1,0,2,100,LL,LL);
OUTSTR("FILE ="&CRLF);
ENTER(DSK,INCHWL,FLAG);
SETFORMAT(25,10);
OUT(DSK,CVS(K)&CVS(KK)&CVF(SIDLEN)&CRLF);
FOR J←1 STEP 1 UNTIL K DO OUT(DSK,CVF(DAT[J,1])&CVF(DAT[J,2])&
CVF(DAT[J,3])&CVF(DAT[J,4])&CRLF);
IF CVN(CURCAM)>0∧CURCAM≠NIL THEN
BEGIN
K ← ARRINFO(GLOBAL DATUM(CURCAM),2);
OUT(DSK,CVS(K)&CRLF);
FOR J←1 STEP 1 UNTIL K DO
BEGIN
FOR I←1 STEP 1 UNTIL 3 DO
OUT(DSK,CVG(GLOBAL DATUM(CURCAM)[J,I]));
OUT(DSK,CRLF);
END;
END ELSE OUT(DSK,"0"&CRLF);
RELEASE(DSK);
END;
COMMENT CALLING PROGRAM FOR FINE OPERATION;
INTERNAL PROCEDURE XFINE(REFERENCE ITEMVAR ARG; REFERENCE INTEGER STATUS);
BEGIN ITEMVAR NARG;
SIMPLE BOOLEAN PROCEDURE TST(REFERENCE INTEGER P;
REFERENCE ITEMVAR ARG);
RETURN(GSTATZ(32,P,FLAG));
IF (PNTR←GETOBJ(ARG,TRUE,TST))<0 THEN
BEGIN
STATUS ← -1;
ARG ← NIL;
RETURN;
END;
NARG ← IF ARG=EVERY THEN CVI(GGETD(PNTR,OBJNUM,FLAG)) ELSE ARG;
OBJLST ← PNTR;
FINSCN({NARG},STATUS);
STATUS ← 0;
END;
COMMENT GUTS OF GET_DATA COMMAND;
PROCEDURE FXUP(REFERENCE LIST OB);
BEGIN ITEMVAR ARG;
INTEGER I;
IF ¬LENGTH(OB) THEN RETURN;
IF OB[1] = NIL THEN
BEGIN
I ← GGETD(OBJLST,OBJNUM,FLAG);
OB ← IF I≥0 THEN {{CVI(I)}} ELSE {{}};
RETURN;
END;
IF OB[1] = EVERY THEN
BEGIN LIST FOO;
SIMPLE BOOLEAN PROCEDURE TEST(REFERENCE INTEGER PNTR;
REFERENCE ITEMVAR ARG);
RETURN(¬LISTX(FOO,ARG,1));
FOO ← PHI;
WHILE GETOBJ(ARG←EVERY,TRUE,TEST)>0 DO
PUT ARG IN FOO AFTER ∞;
OB ← FOO;
END;
END;
INTERNAL BOOLEAN PROCEDURE XGETD(LIST OBJS; STRING JOB);
BEGIN ITEMVAR ARG;
INTEGER SIZ, PNTR, K, I, J, S, SS, SUM;
FXUP(OBJS);
I ← LENGTH(OBJS);
SUM ← SIZ ← 0;
FOR J←1 STEP 1 UNTIL I DO
BEGIN
ARG ← OBJS[J];
IF (PNTR←GETOBJ(ARG,FALSE,DUMMY))<0 THEN CONTINUE;
S ← GGETD(PNTR, PNTNUM, FLAG);
SS ← GCOUNT(PNTR,OUTLIN,K);
IF ¬FLAG∨¬K THEN BEGIN SIZ ← SIZ+S+SS; SUM←SUM+S;END;
END;
IF ¬SIZ THEN RETURN(TRUE);
BEGIN
SAFEX REAL ARRAY DAT[1:(SIZ+5),1:4];
GET_DATA(DAT,K,OBJS);
IF EQU(JOB,"TTY") THEN DUMPDAT(DAT,K,SUM) ELSE
ISSUE(1,"EDGE",JOB,MESSAGE SEND_DATA(K, DAT));
RETURN(FALSE);
END;
END;
COMMENT FIT COMMAND STATUS=-1 ON ENTRY IF NO LINE EXTENDING
TO BE DONE
STATUS= -2 CURVE FITTER BLEW UP (INTERNAL ONLY)
-1 NO OBJECT
0 OK
1 OK BUT NOT A CLOSED CURVE;
INTERNAL PROCEDURE CURVE(REFERENCE ITEMVAR ARG; REFERENCE INTEGER STATUS);
BEGIN INTEGER I, J, SIZ, S;
LABEL L1, L2;
REAL X, Y, XX, YY;
SIMPLE BOOLEAN PROCEDURE TEST(REFERENCE INTEGER PNTR;
REFERENCE ITEMVAR ARG);
RETURN(GSTATZ(8,PNTR,FLAG));
TRACCHK;
IF (PNTR←GETOBJ(ARG,TRUE,TEST))<0 THEN
BEGIN
L1: STATUS ← -1;
ARG ← NIL;
RETURN;
END;
GLBDEL(ARG);
OBJLST ← PNTR;
CURVE_STATUS ← STATUS=-1;
SIZ ← (S←GGETD(PNTR,PNTNUM,FLAG))+GCOUNT(PNTR,OUTLIN,FLAG)+5;
IF SIZ<6 THEN GO TO L1;
BEGIN SAFEX REAL ARRAY DAT[1:SIZ,1:4];
GET_DATA(DAT,SIZ,{{CVI(GGETD(PNTR,OBJNUM,FLAG))}});
IF SIZ<4 THEN GO TO L1;
IF YES_CUR THEN
I←ISSUE(0,"EDGE","CURVE",MESSAGE CURVE_FIT(DAT))
ELSE DUMPDAT(DAT,SIZ,S);
END;
IF YES_CUR THEN QUEUE(7,I);
STATUS ← CURVE_STATUS;
IF STATUS=-2 THEN
BEGIN
REJSUB(ARG,I);
STATUS ← -1;
RETURN;
END;
NEWCAM ← CVI(GGETD(OBJLST,CAMERA,FLAG));
IF NEWCAM≠NIL THEN GLOBAL MAKE XFORM⊗ARG≡NEWCAM;
GSETST(8,OBJLST,FLAG);
IF YES_CUR THEN REGEN(OBJLST);
L2: CORLST ← CURTEM ← TEMPNT ← PNTLST ← SEGLST ← -1;
END;
END "MISC";